home *** CD-ROM | disk | FTP | other *** search
/ The Arsenal Files 8 / The Arsenal Files Collection #8 (Arsenal Computer) (1996).ISO / prg_basi / inputb20.zip / INPUTBOX.BAS < prev    next >
BASIC Source File  |  1996-11-05  |  9KB  |  239 lines
  1. Attribute VB_Name = "InputBoxFunctions"
  2. ' InputBox 2.0 for Visual Basic 4.0
  3. '
  4. ' SHAREWARE, registration is $10
  5. ' See readme.txt for more information on registration
  6. '
  7. ' Functions to replace and enhance VB's built-in InputBox function
  8. ' ⌐1994-1996 Tuomas Salste (vbshop@netgate.net)
  9. '
  10. ' You may use, modify and distribute this source code in your programs as you wish,
  11. ' provided that
  12. ' 1. You have registered
  13. ' 2. You keep this copyright text intact
  14. '
  15. ' **************************************************************************************************************************
  16. ' InputBox(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength)
  17. ' InputLcase(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength)
  18. ' InputUcase(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength)
  19. ' InputPassword(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength, PasswordChar)
  20. ' **************************************************************************************************************************
  21. '
  22. ' These routines replace VB's built-in InputBox() function
  23. '
  24. ' Load InputBox.Bas and InputBox.Frm into your project, and you are ready to
  25. ' replace the built-in InputBox with an enhanced one, automatically
  26. ' YOU DON'T HAVE TO DO ANY CODING!
  27. '
  28. ' **************************************************************************************************************************
  29. '
  30. ' VB's built-in InputBox function is declared like this:
  31. ' > InputBox(Prompt[, Title][, Default][, xpos][, ypos][, HelpFile, Context]) As String
  32. ' Returns a string or "" if the user pressed Cancel
  33. '
  34. ' The new InputBox function is declared like this:
  35. ' > InputBox(Prompt[, Title][, Default][, xpos][, ypos][, HelpFile][, Context][, MaxLength]) As Variant
  36. '
  37. ' DIFFERENCES FROM THE BUILT-IN INPUTBOX FUNCTION:
  38. ' New optional parameter MaxLength to set the maximum length of accepted input
  39. ' Returns Null if the user pressed Cancel (depends on Private Const IBValueOnCancel below)
  40. '
  41. ' **************************************************************************************************************************
  42. '
  43. ' NEW, ENHANCED FUNCTIONS:
  44. ' > InputUcase(Prompt[, Title][, Default][, xpos][, ypos][, HelpFile][, Context][, MaxLength]) As Variant
  45. ' Like InputBox, but turns all input to UPPER CASE
  46. '
  47. ' > InputLcase(Prompt[, Title][, Default][, xpos][, ypos][, HelpFile][, Context][, MaxLength]) As Variant
  48. ' Like InputBox, but turns all input to lower case
  49. '
  50. ' > InputPassword(Prompt[, Title][, Default][, xpos][, ypos][, HelpFile][, Context][, MaxLength][, PasswordChar]) As Variant
  51. ' Like InputBox, but the input is masked with * or character specified by parameter PasswordChar
  52. '               (default mask char * depends on Private Const IBDefaultPasswordChar below)
  53. '
  54. '
  55. ' DEFAULT VALUES IF PARAMETERS NOT SET:
  56. ' PARAMETER       DEFAULT VALUE
  57. ' Title           App.Title
  58. ' Default         ""
  59. ' xpos            Center of parent window or screen
  60. ' ypos            Center of parent window or screen
  61. ' HelpFile        App.HelpFile
  62. ' Context         0
  63. ' MaxLength       None
  64. ' PasswordChar    IPDefaultPasswordChar (originally "*")
  65.  
  66. Option Explicit
  67.  
  68. ' *******************************************************************************
  69. ' User defined constants
  70. '
  71. Private Const IBValueOnCancel = Null      ' Return value when user pressed Cancel
  72. Private Const IBDefaultPasswordChar = "*" ' Default password mask character
  73. #Const UseBuiltInInputBox = False         ' Set to True to disable function InputBox
  74. '
  75. ' End of user defined constants
  76. ' *******************************************************************************
  77.  
  78.  
  79. ' Symbolic constants for internal use
  80.  
  81. Public Const IBUcase = &H10000
  82. Public Const IBLcase = &H20000
  83. Public Const IBPassword = &H40000
  84.  
  85. Public Const InputBoxVersion = 2
  86. Public Const InputBoxVersionName = "InputBox 2.0"
  87.  
  88. Private Sub CenterForm(Parent As Form, Child As Form)
  89. ' Centers Child in relation to Parent
  90.  
  91. Dim x As Integer, y As Integer
  92.  
  93. x = (Parent.Left + Parent.Width / 2) - Child.Width / 2
  94. y = (Parent.Top + Parent.Height / 2) - Child.Height / 2
  95.  
  96. Child.Move x, y
  97.  
  98. End Sub
  99.  
  100. Private Sub CenterToParent(Child As Form)
  101. ' Centers a form to its parent form
  102.  
  103. If Screen.ActiveForm Is Child Then
  104.     ' No parent form
  105.     CenterToScreen Child
  106. Else
  107.     CenterForm Forms(ParentForm(Child)), Child
  108. End If
  109.  
  110. End Sub
  111.  
  112.  
  113. Private Sub CenterToScreen(F As Form)
  114. ' Centers form F to the screen
  115.  
  116. With F
  117.     .Move Screen.Width / 2 - .Width / 2, Screen.Height / 2 - .Height / 2
  118. End With
  119.  
  120. End Sub
  121.  
  122.  
  123. Private Function DoInputBox(ByVal Prompt As String, Optional ByVal Title As Variant, Optional ByVal Default As Variant, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, Optional ByVal HelpFile As Variant, Optional ByVal Context As Variant, Optional ByVal MaxLength As Variant, Optional ByVal Flags As Variant, Optional ByVal PasswordChar As Variant) As Variant
  124. ' Slave function to implement InputBox, InputLCase, InputUCase and InputPassword
  125.  
  126. Dim AppHelpFile As String
  127. AppHelpFile = App.HelpFile
  128.  
  129. Load InputForm
  130.  
  131. With InputForm
  132.     ' Set coordinates
  133.     CenterToParent InputForm
  134.     If IsNumeric(xpos) Then .Left = CLng(xpos)
  135.     If IsNumeric(ypos) Then .Top = CLng(ypos)
  136.     
  137.     ' Set helpfile and context id
  138.     If Not IsMissing(HelpFile) Then App.HelpFile = Format(HelpFile)
  139.     If IsNumeric(Context) Then .HelpContextID = CLng(Context)
  140.  
  141.     ' Set Flags
  142.     If Not IsMissing(Flags) Then
  143.         ' Password
  144.         If Flags And IBPassword Then
  145.             If Not IsMissing(PasswordChar) And Not IsNull(PasswordChar) Then
  146.                 .Answer.PasswordChar = CStr(PasswordChar)
  147.             Else
  148.                 .Answer.PasswordChar = IBDefaultPasswordChar
  149.             End If
  150.         End If
  151.         If Flags And IBUcase Then
  152.             .CharCase = IBUcase
  153.         ElseIf Flags And IBLcase Then
  154.             .CharCase = IBLcase
  155.         Else
  156.             .CharCase = 0
  157.         End If
  158.     End If
  159.     
  160.     ' Set prompt, title
  161.     .Question = Prompt
  162.     If Not IsMissing(Title) And Not IsNull(Title) Then
  163.         .Caption = CStr(Title)
  164.     Else
  165.         .Caption = App.Title
  166.     End If
  167.     
  168.     ' Set default string and maximum length
  169.     If IsNumeric(MaxLength) Then
  170.         .Answer.MaxLength = CLng(MaxLength)
  171.         If Not IsMissing(Default) And Not IsNull(Default) Then .Answer = Left(CStr(Default), CLng(MaxLength))
  172.     Else
  173.         If Not IsMissing(Default) And Not IsNull(Default) Then .Answer = CStr(Default)
  174.     End If
  175.  
  176.     ' Show the form
  177.     .Show vbModal
  178.     
  179.     If .Tag = "OK" Then
  180.         ' If the user pressed OK, return the Answer
  181.         DoInputBox = .Answer
  182.     Else
  183.         ' If the user pressed Cancel, return Null
  184.         DoInputBox = IBValueOnCancel
  185.     End If
  186. End With
  187.  
  188. Unload InputForm
  189. App.HelpFile = AppHelpFile
  190.  
  191. End Function
  192.  
  193.  
  194. #If UseBuiltInInputBox = False Then
  195.  
  196. Public Function InputBox(ByVal Prompt As String, Optional ByVal Title As Variant, Optional ByVal Default As Variant, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, Optional ByVal HelpFile As Variant, Optional ByVal Context As Variant, Optional ByVal MaxLength As Variant) As Variant
  197. ' This corresponds to VB's InputBox(prompt[, title][, default][, xpos][, ypos][, helpfile, context])
  198.  
  199. InputBox = DoInputBox(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength)
  200.  
  201. End Function
  202.  
  203. #End If
  204.  
  205. Public Function InputLCase(ByVal Prompt As String, Optional ByVal Title As Variant, Optional ByVal Default As Variant, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, Optional ByVal HelpFile As Variant, Optional ByVal Context As Variant, Optional ByVal MaxLength As Variant) As Variant
  206. ' Like InputBox but turns all input to lower case
  207.  
  208. InputLCase = DoInputBox(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength, IBLcase)
  209.  
  210. End Function
  211.  
  212. Public Function InputPassword(ByVal Prompt As String, Optional ByVal Title As Variant, Optional ByVal Default As Variant, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, Optional ByVal HelpFile As Variant, Optional ByVal Context As Variant, Optional ByVal MaxLength As Variant, Optional ByVal PasswordChar As Variant) As Variant
  213. ' Like InputBox but masks all input with PasswordChar (IBDefaultPasswordChar if PasswordChar is not set)
  214.  
  215. InputPassword = DoInputBox(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength, IBPassword, PasswordChar)
  216.  
  217. End Function
  218.  
  219. Public Function InputUCase(ByVal Prompt As String, Optional ByVal Title As Variant, Optional ByVal Default As Variant, Optional ByVal xpos As Variant, Optional ByVal ypos As Variant, Optional ByVal HelpFile As Variant, Optional ByVal Context As Variant, Optional ByVal MaxLength As Variant) As Variant
  220. ' Like InputBox but turns all input to UPPER CASE
  221.  
  222. InputUCase = DoInputBox(Prompt, Title, Default, xpos, ypos, HelpFile, Context, MaxLength, IBUcase)
  223.  
  224. End Function
  225. Private Function ParentForm(F As Form) As Integer
  226. ' Returns the index of the parent "forms(_i_)"
  227.  
  228. Dim i As Integer
  229. For i = 0 To Forms.Count - 1
  230.     If Forms(i) Is Screen.ActiveForm Then
  231.         ParentForm = i
  232.         Exit Function
  233.     End If
  234. Next
  235.  
  236. End Function
  237.  
  238.  
  239.